home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
United Public Domain Gold 4
/
United Public Domain Gold 4.iso
/
fredfish
/
ff.0013.dms
/
ff.0013.adf
/
alg1.bas
< prev
next >
Wrap
BASIC Source File
|
1986-02-21
|
4KB
|
129 lines
10 '*** ALGEBRA AND GEOMETRY PROGRAM
20 '** for the IBM PC...requires 32K and Color/Graphics
30 ON ERROR GOTO 1150
40 CLR
70 REM
80 SCREEN 1,2,0:WIDTH 80:SCNCLR : PRINT "ALGEBRA Graphics Program"
90 PRINT " Steve VanArsdale"
100 PRINT "Mt.Prospect, Illinois 312-259-7224"
110 PRINT
120 PRINT "SELECT algebra function:"
130 PRINT "A ... for the SINE of X"
140 PRINT "B ... for the COSINE of X"
150 PRINT "C ... for the TANGENT of X"
160 PRINT "D ... for the SECANT of X"
170 PRINT "E ... for the COTANGENT of X"
180 PRINT "F ... for the COSECANT of X"
190 PRINT "G ... for the INVERSE HYPERBOLIC SINE of X"
200 PRINT "H ... for the SQUARE ROOT of X"
210 PRINT " > ";:GETKEY CHOICE$
220 ON ASC(CHOICE$)-64 GOSUB 1300,1320,1340,1360,1380,1400,1420,1440,1460
230 GOTO 310
300 GOTO 70
310 PRINT "DEPTH OF ";FCTN$;" GRAPH (0 TO 50): ";:INPUT "",DEPTH
320 IF DEPTH < 0 OR DEPTH > 50 THEN GOTO 310
330 SCNCLR:SCREEN 0,2,0 :WIDTH 40
340 '**** GRAPHICS ROUTINE FOR ALGEBRAIC FUNCTIONS ****
350 SCNCLR
360 'SCREEN 1,0:COLOR 0,1
370 C=100:R=100
380 '** AXIS DRAWING ROUTINE
390 GOSUB 1180
400 '** PLOTTING PARAMETERS DISPLAY
410 PRINT AT(1,17); "GRAPH of:"
420 PRINT AT (1,18); FCTN$
430 PRINT AT (1,20); " X Y"
440 '** PLOTTING ROUTINE
450 X=0:Y=0:XX=-1:YY=FNFCTN(XX):DRAW (100,100)
460 FOR X = -1 TO 7 STEP .1
470 PRINT AT (1,21);:PRINT USING "##.##";X
480 REM
490 Y = FNFCTN(X)
500 YLIMIT=98-30*Y : DEPTHLIMIT=100-30*Y-DEPTH : IF YLIMIT < 0 OR YLIMIT > 200 OR DEPTHLIMIT < 0 THEN GOTO 570
510 ON ERROR GOTO 1270
520 PRINT AT (7,21);:PRINT USING "##.##";Y
530 DRAW (20*X+100,100-30*Y),2
540 IF DEPTH <> 0 THEN DRAW (20*X+101,99-30*Y TO 20*X+100+DEPTH,100-30*Y-DEPTH),1
550 DRAW (20*XX+100,100-30*YY TO 20*X+100,100-30*Y),2
560 IF DEPTH <> 0 THEN DRAW (20*XX+100+DEPTH,100-30*YY-DEPTH TO 20*X+100+DEPTH,100-30*Y-DEPTH),2
570 XX=X:YY=Y
580 NEXT X
590 GOSUB 1180
600 PRINT AT (1,23); "ENTER X TO EXIT";:VALUE$=INPUT$(1)
610 IF VALUE$ <> "X" AND VALUE$ <> "x" THEN GOTO 70 ELSE SCNCLR
620 '**** SPECIAL EXIT DISPLAY ****
630 '** AXIS DRAWING SUBROUTINE
640 GOSUB 1180
650 '** PLANE GRID DRAWING ROUTINE
660 FOR X = 10 TO R-10 STEP 10
670 DRAW (C+X,R-X TO 105+C+X,R-X),1
680 DRAW (C+X,R-X TO C+X,0),1
690 DRAW (C,R-X TO 195-X,5),1
700 DRAW (C+X,R TO 195+X,5),1
710 NEXT X
720 PRINT AT (22,1); " Z axis"
730 '** HOOP ROUTINE
740 CIRCLE (160,90),50,1
750 'FOR I = 1 TO 20 STEP
760 'CIRCLE STEP (1,-1),50,1
770 'NEXT I
780 'CIRCLE (160,90),50,1
790 '** ELLIPTICAL TUBE ROUTINE
800 'CIRCLE (155,90),25,1
810 'FOR I = 1 TO 35
820 'CIRCLE STEP (1,1),25,1
830 'NEXT I
840 'CIRCLE STEP (1,1),25,1
850 CIRCLE (155,90),25,.5
860 'FOR I = 1 TO 20
870 'CIRCLE STEP (1,-1),24,1,,,.5
880 'NEXT I
890 CIRCLE (155,90),25,.5
900 '*** CONE ROUTINE
910 CIRCLE (45,55),38,3
920 'FOR I = 1 TO 38
930 'CIRCLE STEP (+1,-1),38-I,(I MOD 2)+2,,,1
940 'NEXT I
950 CIRCLE (45,55),38,1
960 '** GLOBE ROUTINE
970 CIRCLE (245,170),1,2
980 'FOR I = 1 TO 10 STEP 1
990 'CIRCLE STEP (+I/4,-I/4),I*4,1,,,1
1000 'NEXT I
1010 'FOR I = 10 TO 0 STEP -1
1020 'CIRCLE STEP (+I/4,-I/4),I*4,2,,,1
1030 'NEXT I
1040 DRAW (TO 245,170),3
1150 '**** TERMINATION LOGIC
1160 SCNCLR: PRINT "ALGEBRA Program Terminated."
1170 END
1180 '**** AXIS DRAWING SUBROUTINE ****
1190 '**** AXIS DRAWING SUBROUTINE ****
1200 DRAW (C,0 TO C,199),6
1210 DRAW (90,110 TO 200,0),6
1220 DRAW (0,R TO 319,R),6
1230 PRINT AT (1,13); "X axis"
1240 PRINT AT (10,2); "Y axis"
1250 PRINT AT (22,1); " Z axis"
1260 RETURN
1270 '**** CALCULATION ERROR HANDLER
1280 RESUME 390
1290 SCNCLR : PRINT "ALGEBRA Graphics Program"
1300 REM FUNCTION DEFINITION SUBROUTINES
1310 ' SINE
1320 ''DEF FNFCTN(X)=SIN(X):FCTN$="SIN(X)":RETURN
1330 ' COSINE
1340 ''DEF FNFCTN(X)=COS(X):FCTN$="COSINE(X)":RETURN
1350 ' TANGENT
1360 ''DEF FNFCTN(X)=TAN(X):FCTN$="TANGENT(X)":RETURN
1370 ' SECANT
1380 DEF FNFCTN(X)=1/COS(X):FCTN$="SECANT(X)":RETURN
1390 ' COTANGENT
1400 ' DEF FNFCTN(X)=1/TAN(X):FCTN$="COTANGENT(X)":RETURN
1410 ' COSECANT
1420 ' DEF FNFCTN(X)=1/SIN(X):FCTN$="COSECANT(X)":RETURN
1430 ' INVERSE HYPERBOLIC SINE
1440 ' DEF FNFCTN(X)=LOG(X+SQR(X*X+1)):FCTN$="INVERSE HYPERBOLIC SINE(X)":RETURN
1450 ' SQUARE ROOT
1460 ' DEF FNFCTN(X)=SQR(ABS(X)):FCTN$="SQ.RT(X)":RETURN